home *** CD-ROM | disk | FTP | other *** search
/ Mega Guia 2004 June / Mega Guia: 2004-06.iso / _files / free / myalbum / ES / myalbumsetup.exe / {app} / SimpleHTMLGenerator.vbs < prev   
Text File  |  2002-02-28  |  4KB  |  103 lines
  1. ' ------------------------------------------------------------------------------------
  2. ' This is a simple HTML generator written in VBScript
  3. '
  4. '    It uses the current album or a user specified album to build a basic HTML file.
  5. '    As the HTML file can be very memory consumming, the number of pictures
  6. '    processed is limited to 20.
  7. '   The pictures are displayed half size.
  8. ' ------------------------------------------------------------------------------------
  9.  
  10. Option Explicit
  11.  
  12. ' To run this script outside of MyAlbum, un-comment the 2 following lines:
  13. 'dim app
  14. 'set app = CreateObject("MyAlbum.Application")
  15.  
  16. app.ClearTrace
  17.  
  18. const PICTURESIZE=50   ' Picture are resized at 50% of their size
  19.  
  20. Dim alb, pic
  21. if GetAlbum( alb ) then
  22.     Dim outputFileName
  23.     outputFileName = InputBox( "Please enter the name of the HTML file to create", "Simple HTML generator", "Test.html")
  24.     app.Trace "Output file = " & outputFileName
  25.  
  26.     Const ForReading = 1, ForWriting = 2
  27.  
  28.     Dim fso, f, m
  29.     Set fso = CreateObject("Scripting.FileSystemObject")
  30.     Set f = fso.OpenTextFile( outputFileName, ForWriting, True)
  31.     f.WriteLine "<!DOCTYPE html PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
  32.     f.WriteLine "<HTML>" 
  33.     f.WriteLine "<Head>" 
  34.     f.WriteLine "   <META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=iso-8859-1"">"
  35.     f.WriteLine "   <META NAME=""Generator"" CONTENT=""MyAlbum"">"
  36.     f.WriteLine "   <title> " & alb.sAlbumTitle & " - " & alb.sAlbumComment & "</title>"
  37.     f.WriteLine "</Head>" 
  38.     f.WriteLine "<BODY TEXT=""#0000a0"" BGCOLOR=""#c0c0c0"">"
  39.     f.WriteLine "<center><h1>" & alb.sAlbumTitle & "</h1></center>"
  40.     f.WriteLine "<center><h2>" & alb.sAlbumComment & "</h2></center>"
  41.  
  42.     ' Process each picture
  43.     Dim nbPic, i, w
  44.     nbPic = alb.nbPicture
  45.     app.Trace "Pictures in this album: " & nbPic
  46.  
  47.     if nbPic > 25 then
  48.         if vbNo = MsgBox( "This album has a lot of pictures." & chr(13) & "Generate the file for all of them or only the 20 first ones ?", 4, "Big album !") then
  49.             nbPic = 20
  50.         end if
  51.     end if
  52.  
  53.     f.WriteLine "<br><center>"    ' Everything is centered
  54.     for i=0 to nbPic-1
  55.         Set pic = alb.GetPicture(i)
  56.  
  57.         ' Important : convert the filename so it is web-compatible
  58.         Dim albFile
  59.         ' First get the path relative to the album
  60.         albFile = alb.ExpandMacro( pic, "%RP" )
  61.         f.Write "<img src=""" & app.HTMLFileName(albFile, "") & """ ALT=""" & pic.sCommentFirstLine  & """ "
  62.  
  63.         ' Adjust the picture size for display in web browser
  64.         w = PICTURESIZE * pic.w / 100
  65.         f.WriteLine "WIDTH=" & round(w) & " VSPACE=10 HSPACE=30>"
  66.         f.WriteLine "<br>" & pic.sComment & "<HR WIDTH=75%>"
  67.     next
  68.     f.WriteLine "</center>"
  69.  
  70.     f.WriteLine "<center>Build with MyAlbum script</center>"
  71.     f.WriteLine "</BODY>"
  72.     f.WriteLine "</HTML>"
  73.  
  74.     f.Close
  75.  
  76.     app.Trace nbPic & " picture processed"
  77.     app.Trace "HTML file generation complete !"
  78.  
  79.     ' Launch browser
  80.     app.Run outputFileName, True, 0
  81.  
  82. else
  83.     app.Trace "No album to process, exiting !"
  84. end if
  85.  
  86. ' ********************************************************************************
  87. ' *
  88. ' * GetAlbum : get the current album or prompt the user to select one
  89. ' *
  90. Function GetAlbum( byref alb )
  91.     GetAlbum = True
  92.     ' First try to use the current album
  93.     set alb = app.GetCurrentAlbum
  94.     if typeName(alb) = "Nothing" then    ' No album is open
  95.         dim albFile
  96.         albFile = InputBox( "Please enter the name of the album to process", "Simple HTML generator", "")
  97.         set alb = app.LoadAlbum( albFile )
  98.         if typeName(alb) = "Nothing" then
  99.             GetAlbum = False
  100.         end if
  101.     end if
  102. End Function
  103.